home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / ISAMEXPT / ISAMEXPT.ZIP / UUSEISAM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-05  |  30KB  |  1,128 lines
  1. {$x+}
  2.  
  3. { Useisam.Pas   Rev 01.0 vom  9. Juni   89: Isam 3.0 , Turbo 4.0
  4.                 Rev 02.0 vom 24. April  91: Isam 5.21, Turbo 6.0
  5.                 Rev 03.0 vom 26. Mai    92: Isam 5.3 , Turbo 6.0
  6.                 Rev 04.0 vom  3. Januar 93: Isam 5.4 , BP 7.0
  7.                 Rev 05.0 vom 22. August 95: Filer 5.5, Delphi
  8.                 Rev 06.0 vom 30. MΣrz   96: Filer 5.52,Delphi
  9.  
  10.   Inhalt: Routinen zur Unterstⁿtzung der Netisam
  11. }
  12. unit Uuseisam;
  13.  
  14.  
  15. interface
  16.  
  17.  
  18. USES Filer, UToolDll, isamtool;
  19.  
  20.  
  21.  
  22. procedure DIEE;
  23. Procedure DIE;
  24. function  IA:boolean; {Testet, ob Dialog-Meldung vorliegt und löscht sie}
  25. function NotFound:boolean; {Testet, ob bei letzter Op. "nicht gef." herauskam}
  26.  
  27. const Isamwsnr : Longint = 1;
  28.       MySAVE   : Boolean = FALSE;
  29.  
  30. var
  31.   SatzNoAngel : longint;
  32.   IsamFehler  : Integer Absolute IsamError;
  33.   InitCount   : Integer;
  34.  
  35.  
  36.  
  37.  
  38. type
  39.   KeyProc    = Function ( Var DSatz; KeyNr : Word ) : IsamKeyStr;
  40.   ChangeProc = Function(var DatOld,DatNew;Len:word):boolean;
  41.  
  42.  
  43. Function EXISTIsam(IfbPtr:IsamFileBlockPtr;Name:STring):Boolean;
  44. PROCEDURE EXITIsam;
  45. Function INITIsam(Netz:NetSupportType) : Boolean;
  46.  
  47.  
  48. PROCEDURE CLEARKEY(VAR IFBPtr : ISAMFILEBLOCKPTR;KEY: INTEGER);
  49. {Setzt den Datensatzzeiger auf den 1. Schlüssel von Key
  50.  
  51.   IFBPtr  : Dateivariable
  52.   Key     : Keynummer
  53. }
  54.  
  55. PROCEDURE READLOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  56. {Setzt ein READLOCK auf die Datei
  57.  
  58.   IFBPtr  : Dateivariable
  59. }
  60. PROCEDURE LOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  61. {Setzt ein LOCK auf die Datei
  62.  
  63.   IFBPtr  : Dateivariable
  64. }
  65. PROCEDURE UNLOCK(VAR IFBPtr : ISAMFILEBLOCKPTR);
  66. {Hebt den READLOCK auf
  67.  
  68.   IFBPtr  : Dateivariable
  69. }
  70.  
  71.  
  72. procedure SatzLesen (Var IFBPtr : IsamFileBlockPtr;RefNr:longint;
  73.                      var Ziel,Dup);
  74. {Liest einen Satz aus der angegebenen Isam-Datei.
  75.  
  76.   IFBPtr  : Dateivariable
  77.   RefNr   : Datensatznummer des zu lesenden Satzes
  78.   Ziel    : Variable, in der der Satz gespeichert werden soll
  79.   Dup     : muß vom selben Typ wie Ziel sein. Wird von den Schreibprozeduren
  80.             verwendet, um festzustellen, ob der Satz inzwischen verändert
  81.             wurde. Darf daher nicht von Hand verändert werden.
  82.  
  83.   Bitte anschließend IsamOK beachten.
  84.   Fehlermöglichkeiten: wie bei GetNetRec.
  85. }
  86.  
  87. procedure SatzAendern(Var IFBPtr:IsamFileBlockPtr;RefNr:longint;
  88.                       Var Quelle,Dup;Keys:KeyProc;var OK:boolean);
  89. {Schreibt einen geänderten Satz zurück in die Isam-Datei.
  90.  
  91.   IFBPtr  : Dateivariable
  92.   RefNr   : Datensatznummer des zurückzuschreibenden Satzes
  93.   Quelle  : zu schreibender Satz
  94.   Dup     : muß das von SatzLesen erzeugte Duplikat des alten Satzes enthalten
  95.   Keys    : Zeiger auf eine Funktion, die die Datensatzschlüssel ermittelt.
  96.             (s. Anmerkungen zu "type KeyProc" weiter oben.)
  97.   OK      : enthält OK nach der Ausführung FALSE, so konnte nicht geschrieben
  98.             werden, weil der Satz inzwischen verändert wurde oder weil das Än-
  99.             dern einen doppelten Hauptschlüssel zur Folge hätte.
  100.  
  101.   Bitte anschließend IsamOk und OK beachten.
  102.   Fehlermöglichkeiten: wie bei LockFileBlock, GetNetRec, PutNetRec,
  103.   DeleteKey, AddKey, UnlockFile sowie siehe OK.
  104.  
  105. }
  106.  
  107. procedure SatzAnlegen(Var IFBPtr:IsamFileBlockPtr;
  108.                      var Quelle;Keys:KeyProc);
  109. {Legt einen Satz an.
  110.  
  111.   IFBPtr  : Dateivariable
  112.   Quelle  : zu schreibender Satz
  113.   Keys    : s. SatzAendern, type KeyProc
  114.  
  115.   Bitte anschließend IsamOK beachten.
  116.   Fehlermöglichkeiten: wie bei LockFileBlock, AddNetRec, AddKey,
  117.   UnlockFile.
  118.  
  119. }
  120.  
  121.  
  122. procedure Satzloeschen(Var IFBPtr:IsamFileBlockPtr;RefNr:longint;
  123.                        var Dup;Keys:KeyProc;var OK:boolean);
  124. {Löscht einen Satz.
  125.  
  126.   IFBPtr  : Dateivariable
  127.   RefNr   : Nummer des zu löschenden Satzes
  128.   Dup     : s. SatzAendern
  129.   Keys    : s. SatzAendern, type KeyProc
  130.   OK      : s. SatzAendern
  131.  
  132.   Bitte anschließend IsamOk beachten.
  133.   Fehlermöglichkeiten: s. SatzAendern
  134. }
  135.  
  136. procedure DateiOeffnen (var IFBPtr:IsamFileBlockPtr;Name:String;Save:boolean;
  137.           RSize:longint);
  138. {Öffnet einen Fileblock.
  139.  
  140.   IFBPtr  : Dateivariable
  141.   Name    : Pfad+Vorname der Datei
  142.   Save    : TRUE, wenn im Savemodus geöffnet werden soll
  143.   RSize   : Datensatzrecordgröße. Dient der Kontrolle, ob Programm- und
  144.             Dateiversion kompatibel sind.
  145.  
  146.   Bitte anschließend IsamOk beachten.
  147.   Fehlermöglichkeiten wie Open(Save)NetFileBlock.
  148. }
  149.  
  150. procedure DateiSchliessen (var IFBPtr:IsamFileBlockPtr);
  151. {Schließt einen Fileblock.
  152.  
  153.   IFBPtr  : Dateivariable
  154.  
  155.   Bitte anschließend IsamOk beachten.
  156.   Fehlermöglichkeiten wie bei CloseNetFileBlock.
  157. }
  158.  
  159. procedure KeySuchen (var IFBPtr:IsamFileBlockPtr;Key:integer;
  160.                      var Userdatref:Longint;var Userkey:IsamKeyStr;
  161.                      var Found:boolean);
  162. {Sucht einen Schlüssel.
  163.  
  164.   IFBPtr  : Dateivariable
  165.   Key     : Schlüsselnummer
  166.   UserdatRef : erhält die Datensatznummer des gefundenen Schlüssels
  167.   UserKey : zu suchender Schlüssel
  168.   Found   : TRUE:  gewünschter Schlüssel wurde gefunden.
  169.             FALSE: gewünschter Schlüssel wurde nicht gefunden, weil
  170.               IsamOK=TRUE:  er nicht existiert. Userkey enthält den nächsten
  171.                             größeren Schlüssel.
  172.               IsamOK=FALSE: der Zugriff wegen eines Fehlers nicht durchge-
  173.                             führt werden konnte.
  174.  
  175.   Bitte anschließend IsamOk beachten.
  176.   Fehlermöglichkeiten wie bei SearchKey.
  177. }
  178.  
  179. procedure RefSuchen (var IFBPtr:IsamFileBlockPtr;Key:integer;
  180.                      var Userdatref:Longint;var Userkey:IsamKeyStr;
  181.                      var Found:boolean);
  182. {Sucht einen Schlüssel mit Referenz.
  183.  
  184.   IFBPtr  : Dateivariable
  185.   Key     : Schlüsselnummer
  186.   UserdatRef : Datensatznummer des zu suchenden Schlüssels
  187.   UserKey : zu suchender Schlüssel
  188.   Found   : TRUE:  gewünschter Schlüssel wurde gefunden.
  189.             FALSE: gewünschter Schlüssel wurde nicht gefunden, weil
  190.               IsamOK=TRUE:  er nicht existiert. Userkey enthält den nächsten
  191.                             größeren Schlüssel.
  192.               IsamOK=FALSE: der Zugriff wegen eines Fehlers nicht durchge-
  193.                             führt werden konnte.
  194.  
  195.   Bitte anschließend IsamOk beachten.
  196. }
  197.  
  198. procedure SatzEinlesen(var IFBPtr:IsamFileBlockPtr;Key:integer;
  199.                        var Satz,Dup;Keys:KeyProc;var Klar:boolean);
  200. {Liest einen Satz ein. Funktionsweise: Die Felder der Variablen "Satz", die
  201.  bekannt sind, müssen vor Aufruf besetzt werden (z.B. das Kundennummernfeld,
  202.  wenn nach einer Kundennummer gesucht werden soll). Diese Prozedur sucht
  203.  dann den passenden Satz und liest ihn ein.
  204.  
  205.    IFBPtr  : Dateivariable
  206.    Key     : Nummer das Schlüssels, anhanddessen gesucht werden soll
  207.    Satz    : s.o., erhält hinterher den kompletten Satz
  208.    Dup     : s. SatzLesen
  209.    Keys    : s. SatzAendern, type KeyProc
  210.    Klar    : TRUE, wenn der Satz gefunden und ordnungsgemäß gelesen wurde
  211.  
  212.    Bitte anschließend IsamOk beachten.
  213.    Fehlermöglichkeiten wie bei SearchKey, GetNetRec.
  214.  }
  215.  
  216. const
  217.   FindFirst  = 0;
  218.   FindLast   = 1;
  219.   FindNext   = 2;
  220.   FindPrev   = 3;
  221.   FindALL    = 4;
  222.  
  223. procedure NachbarKey(var IFBPtr:IsamFileBlockPtr;Key:integer;
  224.                      var UserDatRef:longint;var UserKey:IsamKeyStr;
  225.                      SuchArt:byte);
  226. {Sucht den nächsten bzw. vorigen Schlüssel.
  227.  
  228.   IFBPtr  : Dateivariable
  229.   Key     : Schlüsselnummer
  230.   UserDatRef : erhält die Datensatznummer des gefundenen Schlüssels
  231.   UserKey : erhält den gefundenen Schlüssel
  232.   SuchArt : 0=der erste Schlüssel wird gesucht
  233.             1=der letzte Schlüssel wird gesucht
  234.             2=der nächste Schlüssel wird gesucht
  235.             3=der vorige   Schlüssel wird gesucht
  236.             4=der erste übereinstimmende Schlüssel (FINDKEY) wird gesucht
  237.  
  238.   Bitte anschließend IsamOk beachten.
  239.   Fehlermöglichkeiten wie bei NextKey, PrevKey, ClearKey.
  240. }
  241.  
  242.  
  243. procedure DeleteAllRecs(var IFBPtr    : IsamFileBlockPtr;
  244.                             VonKey,
  245.                             BisKey    : IsamKeyStr;
  246.                             Key       : integer;
  247.                             Keys      : KeyProc);
  248.  
  249. {Löscht alle Datensätze, die im angegebenen Bereich von Schlüsseln liegen.
  250.  
  251.     IFBPtr  :  bezogener FileBlock
  252.     VonKey  :  kleinster Schlüssel, der gelöscht werden soll
  253.     BisKey  :  kleinster Schlüssel, der nicht mehr gelöscht werden soll
  254.                (also obere Grenze, bleibt selbst aber erhalten)
  255.     Key     :  Schlüsselnummer.
  256. }
  257. procedure LockFile(Var IFBPtr:IsamFileBlockPtr);
  258. procedure UnlockFile(var IFBPtr:IsamFileBlockPtr);
  259. {Achtung: Vor KeysAendern LOCKFILE!!!}
  260. procedure KeysAendern(var IFBPtr:IsamFileBlockPtr;var Quelle,Dup;
  261.           RefNr:longint;Keys:KeyProc;var OK:boolean);
  262.  
  263. const ErrorFile:String = '';
  264.  
  265. var
  266.   NetInUse   : boolean;
  267.  
  268. type
  269.   PrPrTyp   = procedure (s:String);
  270.  
  271. var
  272.   PrPr  : PrPrTyp;
  273.  
  274. const
  275.   IsamAntwort : word = 0;
  276.  
  277. implementation
  278.  
  279. var
  280.   RepCnt  : byte;
  281.  
  282. const
  283.   LastFB  : IsamFileBlockPtr = nil;
  284.   FlushDelay : longint = 900; {Sek.}
  285.  
  286. const
  287.   DelTime     = 100;
  288.   NrOfReps    : byte = 3;
  289.  
  290. Function GetMess(Id: Integer): String;
  291. var S: String;
  292. begin
  293.   if Sprache = 1 then begin
  294.     Case Id of
  295.        1: S:= 'Record is locked, can┤t read.';
  296.        2: S:= 'Repeat ?';
  297.        3: S:= 'File was opened in SAVE-Mode';
  298.        4: S:= 'Can`t open, file is locked';
  299.        5: S:= 'File couldn┤t be closed because of filelock';
  300.        6: S:= 'Press ENTER to try again.';
  301.        7: S:= 'Can`t write, file is locked';
  302.        8: S:= 'Lock error ';
  303.        9: S:= 'Can`t unlock, file is locked by other user.';
  304.       10: S:= 'BTDELETEKEY-Error: ';
  305.       11: S:= 'BTADDKEY-Error: ';
  306.       12: S:= 'LOCKIT-Error: ';
  307.       13: S:= 'RECSIZE-Error: ';
  308.       14: S:= '';
  309.       15: S:= 'GETREC-Error: ';
  310.       16: S:= 'Record change:';
  311.       17: S:= 'keys couldn┤t be changed correctly !';
  312.       18: S:= 'BTPUTREC-Error ';
  313.       19: S:= 'Record change:';
  314.       20: S:= 'Record was changed in the meantime';
  315.       21: S:= 'Attention! IsamError ';
  316.       22: S:= 'Can┤t search, file is locked.';
  317.       23: S:= 'Can┤t skip, file is locked.';
  318.       24: S:= 'reached end of file';
  319.       25: S:= 'IsamError-Message ';
  320.       26: S:= '';
  321.       27: S:= 'CLEARKEY-Error, file is locked.';
  322.       28: S:= 'Can┤t READLOCK, file is locked by other user.';
  323.       29: S:= 'Can┤t LOCK, file is locked by other user.';
  324.       30: S:= 'Can┤t READUNLOCK, file is locked by other user.';
  325.       31: S:= 'That is impossible: InitCount = ';
  326.       else S:= '';
  327.     end;
  328.   end
  329.   else begin
  330.     Case Id of
  331.        1: S:= 'Lesen z.Zt. nicht m÷glich wegen Locking';
  332.        2: S:= 'Wiederholen ?';
  333.        3: S:= 'Datei wurde im SAVEMODUS ge÷ffnet';
  334.        4: S:= 'Zugriff z.Zt. nicht m÷glich wegne Locking';
  335.        5: S:= 'Datei konnte nicht geschlossen werden wegen Locking.';
  336.        6: S:= 'Bitte <RETURN> fⁿr einen neuen Versuch.' ;
  337.        7: S:= 'Schreiben z.Zt. nicht m÷glich wegen Locking.';
  338.        8: S:= 'LockFehler ';
  339.        9: S:= 'UNLOCK z.Zt. nicht m÷glich wegen Locking.';
  340.       10: S:= 'FEHLER BEI BTDELETEKEY: ';
  341.       11: S:= 'FEHLER BEI BTADDKEY: ';
  342.       12: S:= 'FEHLER BEI LOCKIT: ';
  343.       13: S:= 'FEHLER BEI RECSIZE: ';
  344.       14: S:= '';
  345.       15: S:= 'FEHLER BEI GETREC: ';
  346.       16: S:= 'SatzΣndern:';
  347.       17: S:= 'Keys konnten nicht korrekt geΣndert werden!!';
  348.       18: S:= 'Fehler bei BTPUTREC ';
  349.       19: S:= 'SatzΣndern:';
  350.       20: S:= 'Satz wurde zwischenzeitlich von jemand geΣndert.';
  351.       21: S:= 'Achtung! IsamFehler ';
  352.       22: S:= 'Suche z.Zt nicht m÷glich wegen Locking.';
  353.       23: S:= 'BlΣttern z.Zt nicht m÷glich wegen Locking.';
  354.       24: S:= 'Dateiende erreicht';
  355.       25: S:= 'IsamAntwort Meldung';
  356.       26: S:= '';
  357.       27: S:= 'CLEARKEY z.Zt nicht m÷glich wegen Locking.';
  358.       28: S:= 'READLOCK z.Zt nicht m÷glich wegen Locking.';
  359.       29: S:= 'LOCK z.Zt nicht m÷glich wegen Locking.';
  360.       30: S:= 'READUNLOCK z.Zt nicht m÷glich wegen Locking.';
  361.       31: S:= 'Das kann nicht sein: InitCount =';
  362.       else S:= '';
  363.     end;
  364.   end;
  365.   Result:= S;
  366. end;
  367.  
  368. function Compare(var A,B;Count:word):boolean;inline
  369.  
  370. ($59/      {POP CX    (count)}
  371.  $8C/$DA/  {MOV DX,DS (Inhalt sichern)}
  372.  $5E/      {POP SI}
  373.  $1F/      {POP DS    (B)}
  374.  $5F/      {POP DI}
  375.  $07/      {POP ES}
  376.  $FC/      {CLD}
  377.  $B8/$00/$00/{MOV AX,0000}
  378.  $F3/$A6/  {REPZ CMPSB}
  379.  $75/$03/  {JNZ x}
  380.  $B8/$01/$00/{MOV AX,0001}
  381.  $8E/$DA   {x:MOV DS,DX}
  382. );
  383.  
  384.  
  385.  
  386. Procedure Delay(t: Integer);
  387. begin
  388. end;
  389.  
  390. procedure SatzLesen;
  391.  
  392.   label a;
  393.  
  394.   var
  395.     t   : char;
  396.  
  397.   begin
  398.     LastFB := IFBPtr;
  399. a:  RepCnt := NrOfReps;
  400.     repeat
  401.       dec(RepCnt);
  402.       BTGetRec(IFBPtr,RefNr,Ziel,false);
  403.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  404.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  405.     if BTIsamErrorClass=2 then begin
  406.       if JaNein(GetMess(1),GetMess(2))
  407.       then goto a;
  408.     end;
  409.     if IsamOk then move(Ziel,Dup,BTDatRecordSize(IFBPtr));
  410.   end;
  411.  
  412. procedure DateiOeffnen;
  413.  
  414.   label a;
  415.  
  416.   var
  417.     t   : char;
  418.     t2  : byte;
  419.  
  420.   begin
  421.  
  422. a:  RepCnt := NrOfReps;
  423.     repeat
  424.       if RepCnt <> NrOfReps then  waitwindow(intstr(NrOfReps-RepCnt+1)
  425.                                   +'. Versuch Datei÷ffnen'
  426.                                   +#13+'          von '
  427.                                   +Dezstr(NrOfReps)+' Versuchen','wegen Locking');
  428.       dec(RepCnt);
  429.       if MySave then Serrorwindow(GetMess(3),'');
  430.       BTOpenFileBlock(IFBPtr,Name,false,false,MySave,true);
  431.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  432.     CloseWait;
  433.     if BTIsamErrorClass=2 then
  434.     begin
  435.       if JaNein(GetMess(4),GetMess(2))
  436.       then goto a;
  437.     end;
  438.     if IsamOk then
  439.     begin
  440.       for t2 := 1 to IFBPtr^.NrOfKeys do BTSetSearchForSequential(IFBPtr,t2,true);
  441.       if BTDatRecordSize(IFBPtr)<>RSize then
  442.       begin
  443.         isamfehler := 24;
  444.         IsamOk := False;
  445.       end;
  446.       LastFB := IFBPtr;
  447.     end else begin
  448.       LastFB := nil;
  449.       ErrorFile := Name;
  450.       IsamOk := False;
  451.       IsamFehler := IsamError;
  452.     end;
  453.   end;
  454.  
  455.  
  456. procedure DateiSchliessen;
  457.  
  458.   label a;
  459.  
  460.   begin
  461.     LastFB := IFBPtr;
  462. a:  RepCnt := NrOfReps;
  463.     repeat
  464.       dec(RepCnt);
  465.       BTCloseFileBlock(IFBPtr);
  466.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  467.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  468.     if BTIsamErrorClass=2 then begin
  469.       ErrorWindow(GetMess(5)+  ZeroStrToStr(LastFB^.DatF.Name),GetMess(6));
  470.       goto a;
  471.     end;
  472.   end;
  473.  
  474.  
  475. procedure LockFile;
  476.  
  477.   label a;
  478.  
  479.   var
  480.     t : char;
  481.  
  482.   begin
  483.     LastFB := IFBPtr;
  484.     ISAMCLEAROK;
  485. a:  RepCnt := NrOfReps;
  486.     repeat
  487.       dec(RepCnt);
  488.       BTLockFileBlock(IFBPtr);
  489.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  490.     until (BTIsamErrorCLASS<>2) or (RepCnt=0);
  491.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  492.       if JaNein(GetMess(7),GetMess(2))
  493.       then goto a;
  494.     end;
  495.     IF BTIsamErrorClass <> 0 THEN ERRORWINDOW(GetMess(8),DEZSTR(ISAMERROR));
  496.   end;
  497.  
  498. procedure UNLockFile;
  499.  
  500.   label a;
  501.  
  502.   var
  503.     t : char;
  504.  
  505.   begin
  506.     LastFB := IFBPtr;
  507.     ISAMCLEAROK;
  508. a:  RepCnt := NrOfReps;
  509.     repeat
  510.       dec(RepCnt);
  511.       BTUNLockFileBlock(IFBPtr);
  512.     until (BTIsamErrorCLASS<>2) or (RepCnt=0);
  513.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  514.       if JaNein(GetMess(9),GetMess(2))
  515.       then goto a;
  516.     end;
  517.     IF BTIsamErrorClass <> 0 THEN ERRORWINDOW(GetMess(8),DEZSTR(ISAMERROR));
  518.   end;
  519.  
  520.  
  521. type
  522.   tLockArt = (LANoLock,LARdLock,LALock);
  523.  
  524. procedure LockIt(var IFBPtr:IsamFileBlockPtr;var LStore:tLockArt);
  525.   begin
  526.     if BTFileBlockIsReadLocked(IFBPtr) then begin
  527.       LStore := LARdLock;
  528.     end else if BTFileBlockIsLocked    (IFBPtr) then begin
  529.       LStore := LALock
  530.     end else LStore := LANoLock;
  531.     LockFile(IFBPtr);
  532.   end;
  533.  
  534. procedure UnlockIt(var IFBPtr:IsamFileBlockPtr;LStore:tLockArt);
  535.  
  536.   begin
  537.     {*********************************}
  538.     UnlockFile(IFBPtr);
  539.     EXIT;
  540.     {*********************************}
  541.     case LStore of
  542.       LANoLock : UnlockFile(IFBPtr);
  543.       LARdLock : BTReadLockFileBlock(IFBPtr);
  544.       LALock   : ;
  545.     end;
  546.   end;
  547.  
  548. procedure KeysAendern;
  549.  
  550.   var
  551.     ks1,
  552.     ks2     : String;
  553.     FehlNo,
  554.     KeyCnt  : word;
  555.     Status  : boolean;
  556.   Label FEHLER0,FEHLER1,FEHLER2,FEHLER3,FEHLER4;
  557.  
  558.   begin
  559.     LastFB := IFBPtr;
  560.     KeyCnt := 1;
  561.     ISAMCLEAROK;
  562.     while (KeyCnt<=IFBPtr^.NrOfKeys) and IsamOk do
  563.     begin
  564.       Ks1 := KEYS(Quelle,KeyCnt);
  565.       Ks2 := KEYS(DUP,KeyCnt);
  566.       Status := false;
  567.       if ks1<>Ks2 then begin
  568.    FEHLER0:
  569.         ISAMCLEAROK;
  570.         BTDeleteKey(IFBPtr,KeyCnt,RefNr,ks2);
  571.         IF NOT ISAMOK THEN IF JANEIN(GetMess(10)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER0;
  572.         if IsamOk then
  573.         begin
  574.           Status := true;
  575.    FEHLER1:
  576.           ISAMCLEAROK;
  577.           BTAddKey(IFBPtr,KeyCnt,RefNr,ks1);
  578.           IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER1;
  579.         end;
  580.       end;
  581.       if IsamOk then inc(KeyCnt);
  582.     end;
  583.  
  584.  
  585.     OK := IsamOk;
  586.     if not IsamOk then
  587.     begin
  588.       FehlNo := IsamError;
  589.       if Status then
  590.       BEGIN
  591.    FEHLER2:
  592.         ISAMCLEAROK;
  593.         BTAddKey(IFBPtr,KeyCnt,RefNr,ks2);
  594.         IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+'2'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER2;
  595.       END;
  596.       for KeyCnt := 1 to KeyCnt-1 do begin
  597.         Ks1 := KEYS(Quelle,KeyCnt);
  598.         Ks2 := KEYS(DUP,KeyCnt);
  599.         Status := false;
  600.         if ks1<>Ks2 then
  601.         begin
  602.             ISAMCLEAROK;
  603.    FEHLER3:
  604.             BTDeleteKey(IFBPtr,KeyCnt,RefNr,ks1);
  605.             IF NOT ISAMOK THEN IF JANEIN(GetMess(10)+'2'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER3;
  606.    FEHLER4:
  607.             ISAMCLEAROK;
  608.             BTAddKey(IFBPtr,KeyCnt,RefNr,ks2);
  609.             IF NOT ISAMOK THEN IF JANEIN(GetMess(11)+'3'+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER4;
  610.         end;
  611.       end;
  612.       if IsamOk then IsamError := FehlNo;
  613.       if IsamError=10230 then
  614.       begin {Schlⁿssel doppelt}
  615.         IsamError := 0;
  616.         IsamOk     := true;
  617.       end else IsamOk := false;
  618.     end;
  619.   end;
  620.  
  621. procedure SatzAendern;
  622.  
  623.   label
  624.     Hilfe;
  625.  
  626.   var
  627.     tds        : pointer;
  628.     rs         : longint;
  629.     KeyCnt     : word;
  630.     WarLocked  : tLockArt;
  631.     LABEL FEHLER0,FEHLER1,FEHLER2,FEHLER3,FEHLER4;
  632.  
  633.   begin
  634.     OK := false;
  635.  
  636.   FEHLER0:
  637.     ISAMCLEAROK;
  638.     LockIt(IFBPtr,WarLocked);
  639.     IF NOT ISAMOK THEN IF JANEIN(GetMess(12)+ INTSTR(ISAMERROR),GetMess(2)) THEN GOTO FEHLER0;
  640.     if IsamOk then
  641.     begin
  642.   FEHLER1:
  643.       ISAMCLEAROK;
  644.       rs := BTDatRecordSize(IFBPtr);
  645.       IF NOT ISAMOK THEN IF JANEIN(GetMess(13)+ INTSTR(ISAMERROR),'RS: '+DEZSTR(RS)+GetMess(2)) THEN GOTO FEHLER1;
  646.       getmem(tds,rs);
  647.   FEHLER2:
  648.       ISAMCLEAROK;
  649.       BTGetRec (IFBPtr,RefNr,tds^,TRUE); {HIER WAR FALSE!!!
  650.                                           bei einem Lock wird nun trotzdem
  651.                                           gelesen}
  652.       IF NOT ISAMOK THEN IF JANEIN(GetMess(15)+INTSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER2;
  653.       if not IsamOk then goto Hilfe;
  654.       if compare (tds^,Dup,rs) then
  655.       begin
  656.         KeysAendern(IFBPtr,Quelle,Dup,RefNr,Keys,OK);
  657.         if not OK then errorwindow ('SatzÄndern:',
  658.         'Keys konnten nicht korrekt geändert werden!!');
  659.         OK := true;
  660.   FEHLER3:
  661.         ISAMCLEAROK;
  662.         BTPutRec(IFBPtr,RefNr,Quelle,false);
  663.         IF NOT ISAMOK THEN IF JANEIN(GetMess(18)+ DEZSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER3;
  664.       end else errorwindow(GetMess(19),GetMess(20));
  665.   Hilfe:
  666.       IF NOT ISAMOK THEN  ERRORWINDOW('WSNR  : ',
  667.                                       'ERROR: '+INTSTR(IsamError));
  668.       KeyCnt := IsamError;
  669.       freemem(tds,rs);
  670.   FEHLER4:
  671.       ISAMCLEAROK;
  672.       UnlockIt(IFBPtr,WarLocked);
  673.       IF NOT ISAMOK THEN IF JANEIN(GetMess(12)+ INTSTR(ISAMERROR),'REF: '+DEZSTR(REFNR)+GetMess(2)) THEN GOTO FEHLER4;
  674.       if IsamOk then
  675.       begin
  676.         IsamOk := KeyCnt =0;
  677.         IsamError := KeyCnt;
  678.       end;
  679.       IF ISAMERROR = 10070 THEN ERRORWINDOW('?????','');
  680.     end;
  681.   end;
  682.  
  683.  
  684.  
  685. procedure SatzAnlegen;
  686.  
  687.   var
  688.     StIF,
  689.     KeyCnt    : word;
  690.     RefNr     : longint;
  691.     WarLocked : tLockArt;
  692.     schluessel: isamkeySTR;
  693.  
  694.   begin
  695.     LockIt(IFBPtr,WarLocked);
  696.     if IsamOk then
  697.     begin
  698.       BTAddRec(IFBPtr,RefNr,Quelle);
  699.       SatzNoAngel := RefNr;
  700.       if IsamOk then
  701.       begin
  702.         KeyCnt := 1;
  703.         while (KeyCnt<=IFBPtr^.NrOfKeys) and IsamOk do
  704.         begin
  705.            BTAddKey(IFBPtr,KeyCnt,RefNr,KEYS(Quelle,KeyCnt));
  706.            inc(KeyCnt);
  707.         end;
  708.         if not IsamOk then
  709.         begin
  710.           StIF := IsamError;
  711.           dec(keycnt);
  712.           while keycnt > 1 do
  713.           begin
  714.             dec(keycnt);
  715.             BTDELETEKEY(IFBptr,keycnt,refnr,keys(quelle,keycnt));
  716.           end;
  717.  
  718.           BTDeleteRec(IFBPtr,Refnr);
  719.           IsamError := StIF;
  720.           IsamOK := false;
  721.         end;
  722.       end;
  723.       KeyCnt := IsamError;
  724.       UnlockIt(IFBPtr,WarLocked);
  725.       if IsamOk then
  726.       begin
  727.         IsamOk := KeyCnt =0;
  728.         IsamError := KeyCnt;
  729.       end;
  730.     end;
  731.   end;
  732.  
  733.  
  734.  
  735. procedure Satzloeschen;
  736. label hilfe;
  737.  
  738.   var
  739.     tds       : pointer;
  740.     rs        : longint;
  741.     KeyCnt    : word;
  742.     WarLocked : tLockArt;
  743.  
  744.   begin
  745.     OK := false;
  746.     LockIt(IFBPtr,WarLocked);
  747.     if IsamOk then begin
  748.       rs := BTDatRecordSize(IFBPtr);
  749.       getmem(tds,rs);
  750.       BTGetRec (IFBPtr,RefNr,tds^,false);
  751.       if not IsamOk then goto Hilfe;
  752.       if compare (tds^,Dup,rs) then begin
  753.         for KeyCnt := 1 to IFBPtr^.NrOfKeys do begin
  754.           BTDeleteKey(IFBPtr,KeyCnt,RefNr,Keys(Dup,KeyCnt));
  755.         end;
  756.         BTDeleteRec(IFBPtr,RefNr);
  757.         OK := true;
  758.       end;
  759. Hilfe:
  760.       KeyCnt := IsamError;
  761.       freemem(tds,rs);
  762.       UnlockIt(IFBPtr,WarLocked);
  763.       if IsamOk then begin
  764.         IsamOk := KeyCnt =0;
  765.         IsamError := KeyCnt;
  766.       end;
  767.     end;
  768.   end;
  769.  
  770. procedure KeySuchen;
  771.  
  772.   label a;
  773.  
  774.   var
  775.     t   : char;
  776.     tk  : IsamKeyStr;
  777.  
  778.   begin
  779.     LastFB := IFBPtr;
  780. a:  RepCnt := NrOfReps;
  781.     tk := UserKey;
  782.     repeat
  783.       dec(RepCnt);
  784.       BTSearchKey(IFBPtr,Key,UserDatRef,tk);
  785.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  786.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  787.     if BTIsamErrorClass=2 then begin
  788.       if JaNein(GetMess(22),GetMess(2))
  789.       then goto a;
  790.     end;
  791.     if IsamOk then Found := UserKey=tk else Found := false;
  792.     UserKey := tk;
  793.   end;
  794.  
  795. procedure RefSuchen;
  796.  
  797.   label a;
  798.  
  799.   var
  800.     t   : char;
  801.     tk  : IsamKeyStr;
  802.     tr  : longint;
  803.  
  804.   begin
  805.     LastFB := IFBPtr;
  806. a:  RepCnt := NrOfReps;
  807.     tk := UserKey;
  808.     tr := UserDatRef;
  809.     repeat
  810.       dec(RepCnt);
  811.       BTFindKeyAndRef(IFBPtr,Key,tr,tk,+1);
  812.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  813.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  814.     if BTIsamErrorClass=2 then begin
  815.       if JaNein(GetMess(22),GetMess(2))
  816.       then goto a;
  817.     end;
  818.     if IsamOk then Found := (UserKey=tk) and (UserDatRef=tr) else Found := false;
  819.     UserKey := tk;
  820.     UserDatRef := tr;
  821.   end;
  822.  
  823. procedure SatzEinlesen;
  824.  
  825.   var
  826.     Ref : longint;
  827.     x   : IsamKeyStr;
  828.  
  829.   begin
  830.     LastFB := IFBPtr;
  831.     x := Keys(Satz,KEY);
  832.     KeySuchen(IFBPtr,Key,Ref,x,Klar);
  833.     if Klar then SatzLesen (IFBPtr,Ref,Satz,Dup);
  834.     klar := Klar and IsamOK;
  835.   end;
  836.  
  837. procedure NachbarKey;
  838.  
  839.   label a;
  840.  
  841.   var
  842.     t   : char;
  843.     uk  : IsamKeyStr;
  844.     FOUND:BOOLEAN;
  845.  
  846.   begin
  847.     LastFB := IFBPtr;
  848.  
  849. a:  RepCnt := NrOfReps;
  850.     uk := USERKEY;
  851.     ISAMCLEAROK;
  852.     REPEAT
  853.       dec (RepCnt);
  854.       if Suchart=4 then
  855.       BEGIN
  856.         KeySuchen(IFBPtr,Key,UserDatRef,USERKEY,FOUND);
  857.         EXIT;
  858.       END;
  859.       if SuchArt<2 then BTClearKey(IFBPtr,Key) else IsamOk := true;
  860.       if IsamOK then if odd(SuchArt)
  861.       then BTPrevKey(IFBPtr,Key,UserDatRef,uk)
  862.       else BTNextKey(IFBPtr,Key,UserDatRef,uk);
  863.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  864.     UNTIL (BTISAMERRORCLASS<> 2) OR (RepCnt = 0);
  865.     if RepCnt=0 then begin
  866.       if JaNein(GetMess(23),GetMess(2))
  867.       then goto a;
  868.     end;
  869.     if IsamOK then UserKey := uk;
  870.   end;
  871.  
  872.  
  873.  
  874. function IA;
  875.  
  876.   begin
  877.     IA := (IsamAntwort <>0);
  878.     IsamAntwort := 0;
  879.   end;
  880.  
  881. var Klasse : byte;
  882. {   Codes v. IsamErrorClass:
  883.   0 : kein Fehler;
  884.   1 : Dialog-Meldung;
  885.   2 : Locking-Fehler (kann nur durch eine Netz-Operation erfolgen);
  886.   3 : Operation im Save-Modus nicht ausgeführt;
  887.   4 : schwerer Fehler (Abbruch empfohlen);
  888.   99: unbekannter Fehler;}
  889.  
  890.  
  891.  
  892. procedure DIEE;
  893. VAR PROT  : TEXT;
  894.     DUMMY,D,Z : LONGINT;
  895.   begin
  896.     if IsamAntwort<>0 then
  897.     if (Isamantwort = 10250) or (IsamAntwort = 10260)
  898.     then SErrorWindow(GetMess(24),'') else
  899.     if IsamAntwort<>0 then if Isamantwort <> 10210 then SErrorWindow(GetMess(25) ,IntStr(IsamAntwort));
  900.     IsamAntwort := 0;
  901.     if not IsamOk then begin
  902.     case IsamError of
  903.         9900,
  904.         9903,
  905.         10410 : Klasse := 4;
  906.         else  Klasse := BTIsamErrorClass;
  907.      end;
  908.       case Klasse of
  909.         3,4 :
  910.         begin
  911.           GetSysZeit(D,Z);
  912.           if LastFB<>nil then ErrorFile := ZeroStrToStr(LastFB^.DatF.Name);
  913.           ERRORWINDOW(GetMess(21)+INTSTR(IsamError)+' / WS: '{+DEZSTR(ISAMWSNR)}+
  914.                       ' / '+ERRORFILE,'');
  915.          assign (Prot,'C:\EXITPROT.TXT');
  916. {$I-}
  917.          append(prot);
  918. {$I+}
  919.         dummy := ioresult;
  920.         If dummy <> 0 then rewrite(Prot);
  921.         writeln (Prot,DATESTR(D),' ',TimeStr(Z),
  922.         ' ISAMERROR '+INTSTR(IsamError)+' / '+ERRORFILE);
  923.          CLOSE(PROT);
  924.         end;
  925.         1 : IsamAntwort := IsamError; {Dialog-Meldung, nicht weiter beachten}
  926.  
  927.         2 : BEGIN
  928.               if LastFB<>nil then ErrorFile := ZeroStrToStr(LastFB^.DatF.Name);
  929.                ErrorWindow('LOCK ERROR/'{+DEZSTR(ISAMWSNR)}+ '/'+VERSIONSTR+'/'+INTSTR(IsamError)+
  930.               '/'+ERRORFILE,'');
  931.               IsamAntwort := IsamError;
  932.             END;
  933.  
  934.         0 : BEGIN
  935.               IsamAntwort := IsamError;
  936.             END;
  937.  
  938.       end; {of CASE}
  939.     end;
  940.     LastFB := nil;
  941.   end;
  942.  
  943. Procedure die;
  944. Begin
  945.   DIEE;
  946. end;
  947.  
  948.  
  949. var
  950.   GlobFuncBuildKey  : KeyProc;
  951.  
  952. function MyBuildKey(var DatS;KeyNr:Integer):IsamKeyStr;
  953.  
  954.   begin
  955.     MyBuildKey := GlobFuncBuildKey(DatS,KeyNr);
  956.   end;
  957.  
  958.  
  959. procedure DeleteAllRecs(var IFBPtr    : IsamFileBlockPtr;
  960.                             VonKey,
  961.                             BisKey    : IsamKeyStr;
  962.                             Key       : integer;
  963.                             Keys      : KeyProc);
  964.  
  965.   var
  966.     WarLocked  : tLockArt;
  967.     rs         : word;
  968.     Ref        : longint;
  969.     fnd        : boolean;
  970.     tds        : pointer;
  971.     AktKey     : IsamKeyStr;
  972.  
  973.   begin
  974.     LockIt(IFBPtr,WarLocked);
  975.     DIEE;
  976.     rs := BTDatRecordSize(IFBPtr);
  977.     getmem(tds,rs);
  978.     Ref := 0;
  979.     AktKey := VonKey;
  980.     KeySuchen(IFBPtr,Key,Ref,AktKey,fnd);
  981.     DIEE;
  982.     while (AktKey<BisKey) and not IA do begin
  983.       SatzLesen(IFBPtr,Ref,tds^,tds^);
  984.       DIEE;
  985.       SatzLoeschen(IFBPtr,Ref,tds^,Keys,fnd);
  986.       DIEE;
  987.       KeySuchen(IFBPtr,Key,Ref,AktKey,fnd);
  988.       DIEE;
  989.     end;
  990.     freemem(tds,rs);
  991.     UnLockIt(IFBPtr,WarLocked);
  992.   end;
  993.  
  994. function NotFound;
  995.  
  996.   begin
  997.     NotFound := IA and (IsamError=10200);
  998.   end;
  999.  
  1000. Procedure ClearKey;
  1001. label a;
  1002. var
  1003.   t   : char;
  1004.   tk  : IsamKeyStr;
  1005. BEGIN
  1006.   LastFB := IFBPtr;
  1007. a:RepCnt := NrOfReps;
  1008.   repeat
  1009.     dec(RepCnt);
  1010.     BTCLEARKEY(IfbPtr,KEY);
  1011.     IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1012.   until (BTIsamErrorClass<>2) or (RepCnt=0);
  1013.   if BTIsamErrorClass=2 then
  1014.   begin
  1015.      if JaNein(GetMess(27),GetMess(2))
  1016.      then goto a;
  1017.    end;
  1018.  end;
  1019.  
  1020.  
  1021. Procedure READLOCK;
  1022. label a;
  1023. var
  1024.   t   : char;
  1025.   tk  : IsamKeyStr;
  1026. BEGIN
  1027.     LastFB := IFBPtr;
  1028. a:  RepCnt := NrOfReps;
  1029.     repeat
  1030.       dec(RepCnt);
  1031.       BTREADLOCKFILEBLOCK(IfbPtr);
  1032.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1033.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1034.     if BTIsamErrorClass=2 then begin
  1035.       if JaNein(GetMess(28),GetMess(2))
  1036.      then goto a;
  1037.     end;
  1038.   end;
  1039.  
  1040. Procedure LOCK;
  1041. label a;
  1042. var
  1043.   t   : char;
  1044.   tk  : IsamKeyStr;
  1045. BEGIN
  1046.     LastFB := IFBPtr;
  1047. a:  RepCnt := NrOfReps;
  1048.     repeat
  1049.       dec(RepCnt);
  1050.       BTLOCKFILEBLOCK(IfbPtr);
  1051.       IF NOT ISAMOK AND (DELTIME <> 0) THEN DELAY(DELTIME);
  1052.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1053.     if BTIsamErrorClass=2 then begin
  1054.       if JaNein(GetMess(29),GetMess(2))
  1055.      then goto a;
  1056.     end;
  1057.   end;
  1058.  
  1059.  
  1060.  
  1061.  
  1062. Procedure UNLOCK;
  1063. label a;
  1064. var
  1065.   t   : char;
  1066.   tk  : IsamKeyStr;
  1067. BEGIN
  1068.     LastFB := IFBPtr;
  1069. a:  RepCnt := NrOfReps;
  1070.     repeat
  1071.       dec(RepCnt);
  1072.       BTUNLOCKFILEBLOCK(IfbPtr);
  1073.     until (BTIsamErrorClass<>2) or (RepCnt=0);
  1074.     if (BTIsamErrorClass=2) OR NOT ISAMOK then begin
  1075.       if JaNein(GetMess(30),GetMess(2))
  1076.      then goto a;
  1077.     end;
  1078.   end;
  1079.  
  1080.  
  1081. Function INITIsam(Netz:NetSupportType) : Boolean;
  1082. Var
  1083.   b : Boolean;
  1084. BEGIN
  1085.   if InitCount < 1 then begin
  1086.     b := False;
  1087.     BTinitisam(Netz,30{30000+MINIMIZEUSEOFNORMALHEAP,0});
  1088.     Diee;
  1089.     If Isamok then b := True;
  1090.     INITIsam := b;
  1091.     Inc(InitCount);
  1092.   end else Inc(InitCount);
  1093. END;
  1094.  
  1095.  
  1096. PROCEDURE EXITIsam;
  1097. BEGIN
  1098.   if InitCount < 0 then errorwindow(GetMess(31),'InitCount =' + intStr(InitCount));
  1099.   if InitCount < 2 then
  1100.   begin
  1101.     BTUNLOCKALLOPENFILEBLOCKS;
  1102.     BTCloseAllFileBlocks;
  1103.     BTExitIsam;
  1104.     Dec(InitCount);
  1105.   end else Dec(InitCount);
  1106. END;
  1107.  
  1108. {ST}
  1109. Function EXISTIsam(IfbPtr:IsamFileBlockPtr;Name:STring):Boolean;
  1110. Var
  1111. B : Boolean;
  1112. begin
  1113.   B := True;
  1114.   BTOpenFileBlock(IFBPtr,Name,false,false,false,true);
  1115.   if Isamerror = 9903 then B := False ;
  1116.   BTCloseFileBlock(IFBPtr);
  1117.   IsamError := 0;
  1118.   Isamok := true;
  1119.   ExistIsam := B;
  1120. end;
  1121. {ST}
  1122.  
  1123. begin
  1124.   MySave := False;
  1125.   InitCount := 0;
  1126. end.
  1127.  
  1128.